perm filename 2P.LAP[W77,JMC] blob
sn#259363 filedate 1977-01-22 generic text, type T, neo UTF8
'(THIS IS THE LAP FOR (2P /16 DSK EF))
'(COMPILED BY LISP FAST-ARITHMETIC COMPILER /669)
;COMPILED ON TUESDAY, OCTOBER 12, 1976, AT 9:50 AM
(SETQ BASE (SETQ IBASE 12))
(SETQ *NOPOINT T)
(LAP SEX SUBR)
(ARGS SEX (NIL . 3))
(PUSH P 1)
(PUSH P 2)
(PUSH P 3)
(EXCH 1 2)
(CALL 1 'LFY)
(PUSH P 1)
(MOVE 1 -3 P)
(JSP T PDLNMK)
(PUSH P (% 0 0 '1))
(PUSH P 1)
(MOVEI 1 '12)
(MOVEM 1 (SPECIAL IBASE))
(MOVEM 1 (SPECIAL BASE))
G0001
(SKIPE 1 -2 P)
(JRST 0 G0005)
(MOVE 1 -1 P)
(JRST 0 G0006)
G0005
(HLRZ 2 0 1)
(JUMPE 2 G0004)
(MOVE 2 0 P)
(MOVE 1 -1 P)
(CALL 2 '*TIMES)
(MOVE 2 -3 P)
(CALL 2 'REMAINDER)
(MOVEM 1 -1 P)
G0004
(HRRZ 1 @ -2 P)
(MOVE 2 0 P)
(MOVEM 1 -2 P)
(MOVEI 1 0 2)
(CALL 2 '*TIMES)
(MOVE 2 -3 P)
(CALL 2 'REMAINDER)
(MOVEM 1 0 P)
(JRST 0 G0001)
G0006
(SUB P (% 0 0 6 6))
(POPJ P)
NIL
(LAP TEST1 SUBR)
(ARGS TEST1 (NIL . 2))
(PUSH P 1)
(MOVEI 1 0 2)
(CALL 1 'SUB1)
(MOVEI 3 0 2)
(EXCH 2 1)
(POP P 1)
(CALL 3 'SEX)
(MOVEI 2 '1)
(JCALL 2 'EQUAL)
NIL
(LAP SEARCH SUBR)
(ARGS SEARCH (NIL . 3))
(PUSH P 1)
(PUSH P 2)
(PUSH P 3)
(MOVEI 2 '2)
(CALL 2 'REMAINDER)
(MOVE 7 0 1)
(JUMPN 7 G0006)
(MOVE 1 -2 P)
(CALL 1 'ADD1)
(JRST 0 G0005)
G0006
(MOVE 1 -2 P)
G0005
(JSP T PDLNMK)
(MOVEM 1 -2 P)
(MOVE 1 -1 P)
(CALL 1 'MINUSP)
(JUMPE 1 G0013)
(SKIPA 1 (% 0 0 '-2))
G0013
(MOVEI 1 '2)
(PUSH P (% 0 0 'NIL))
(PUSH P (% 0 0 'NIL))
(PUSH P 1)
(PUSH P (% 0 0 '0))
G0002
(MOVE 1 0 P)
(CALL 1 'ABS)
(PUSH P 1)
(MOVE 1 -6 P)
(CALL 1 'ABS)
(POP P 2)
(CALL 2 '*LESS)
(JUMPE 1 G0016)
(MOVEI 1 'DONE)
(JRST 0 G0021)
G0016
(MOVE 2 -6 P)
(MOVE 1 0 P)
(CALL 2 '*PLUS)
(MOVEM 1 (SPECIAL K))
(MOVEI 2 '176440632660)
(CALL 2 '*GREAT)
(JUMPE 1 G0024)
(MOVEI 1 '176440632657)
(JRST 0 G0023)
G0024
(MOVE 1 (SPECIAL K))
(CALL 1 'SUB1)
G0023
(MOVEM 1 -3 P)
(PUSH P (% 0 0 '1))
G0004
(MOVEI T G0032)
(PUSH P T)
(PUSH P -5 P)
(MOVNI T 1)
(NJCALL 16 'RANDOM)
G0032
(ADDI 7 1)
(MOVE 2 (SPECIAL K))
(PUSH FXP 7)
(MOVEI 1 0 FXP)
(CALL 2 'TEST1)
(SUB FXP (% 0 0 1 1))
(JUMPE 1 G0031)
(MOVE 2 -5 P)
(MOVE 1 0 P)
(CALL 2 '*GREAT)
(JUMPE 1 G0029)
G0031
(MOVE 2 -5 P)
(MOVE 1 0 P)
(CALL 2 '*GREAT)
(JUMPE 1 G0038)
(MOVE 1 (SPECIAL K))
(CALL 1 'PRINT)
(MOVE 2 -3 P)
(MOVE 1 (SPECIAL K))
(CALL 2 'CONS)
(MOVEM 1 -3 P)
G0038
(JRST 0 G0042)
G0029
(MOVE 1 0 P)
(CALL 1 'ADD1)
(MOVEM 1 0 P)
(JRST 0 G0004)
G0042
(SUB P (% 0 0 1 1))
(MOVE 2 -1 P)
(MOVE 1 0 P)
(CALL 2 '*PLUS)
(MOVEM 1 0 P)
(JRST 0 G0002)
G0021
(SUB P (% 0 0 1 1))
(MOVE 1 -1 P)
(SUB P (% 0 0 6 6))
(JCALL 1 'REVERSE)
NIL
(LAP CH SUBR)
(ARGS CH (NIL . 3))
(JSP T SPECBIND)
(0 2 (SPECIAL K))
(PUSH P 1)
(PUSH P 3)
(EXCH 2 3)
(EXCH 1 3)
(CALL 2 '*TIMES)
(MOVEI 3 0 1)
(MOVEI 2 0 1)
(PUSH P 1)
(MOVE 1 -2 P)
(CALL 3 'SEX)
(MOVE 3 0 P)
(MOVE 2 (SPECIAL K))
(PUSH P 1)
(MOVE 1 -3 P)
(CALL 3 'SEX)
(MOVEI 2 0 1)
(POP P 1)
(CALL 2 '*DIF)
(SUB P (% 0 0 3 3))
(JRST 0 UNBIND)
NIL
(LAP PT SUBR)
(ARGS PT (NIL . 1))
(MOVEI 3 '24)
(MOVEI 2 '1)
(JCALL 3 'SEARCH)
NIL
(LAP LFY SUBR)
(ARGS LFY (NIL . 1))
(PUSH P 1)
(CALL 1 'BIGP)
(JUMPE 1 G0007)
(HRRZ 1 @ 0 P)
(CALL 1 'REVERSE)
(JRST 0 G0006)
G0007
(MOVE 1 0 P)
(CALL 1 'ABS)
(CALL 1 'NCONS)
G0006
(PUSH P 1)
(PUSH P (% 0 0 'NIL))
(PUSH P (% 0 0 'NIL))
G0002
(SKIPE 1 -2 P)
(JRST 0 G0015)
(MOVE 1 -1 P)
(JRST 0 G0017)
G0015
(HLRZ 7 0 1)
(MOVE 7 0 7)
(LSH 7 1)
(JSP T FXCONS)
(PUSH P (% 0 0 '1))
(JSP T SPECBIND)
(0 1 (SPECIAL K))
G0004
(MOVEI 2 '44)
(MOVE 1 0 P)
(CALL 2 'EQUAL)
(JUMPN 1 G0022)
G0005
(SKIPN 1 -1 P)
(JRST 0 G0025)
(MOVE 1 (SPECIAL K))
(CALL 1 'MINUSP)
(JUMPN 1 G0027)
(SKIPA)
G0027
(MOVEI 1 'T)
(MOVE 2 -2 P)
(CALL 2 'CONS)
(MOVEM 1 -2 P)
(JRST 0 G0024)
G0025
(MOVE 1 (SPECIAL K))
(CALL 1 'MINUSP)
(JUMPE 1 G0024)
(MOVEI 5 'T)
(MOVEM 5 -1 P)
(JRST 0 G0005)
G0024
(MOVE 1 0 P)
(CALL 1 'ADD1)
(MOVE 7 @ (SPECIAL K))
(LSH 7 1)
(PUSH P 1)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL K))
(POP P -1 P)
(JRST 0 G0004)
G0022
(SUB P (% 0 0 1 1))
(PUSHJ P UNBIND)
(HRRZ 1 @ -2 P)
(MOVEM 1 -2 P)
(JRST 0 G0002)
G0017
(SUB P (% 0 0 4 4))
(POPJ P)
NIL
(LAP CLEAN SUBR)
(ARGS CLEAN (NIL . 1))
(PUSH P 1)
(JSP T PDLNMK)
(JUMPE 1 G0001)
(HRRZ 2 @ 0 P)
(JUMPN 2 G0003)
(MOVE 1 0 P)
(JSP T PDLNMK)
(JRST 0 G0001)
G0003
(HLRZ 7 @ 0 P)
(MOVE 7 0 7)
(HLRZ 10 0 2)
(MOVE 10 0 10)
(CAME 7 10)
(JRST 0 G0006)
(EXCH 1 2)
(CALL 1 'CLEAN)
(JRST 0 G0001)
G0006
(HLRZ 1 @ 0 P)
(PUSH P 1)
(EXCH 1 2)
(CALL 1 'CLEAN)
(POP P 2)
(CALL 2 'XCONS)
G0001
(SUB P (% 0 0 1 1))
(POPJ P)
NIL
(LAP FF SUBR)
(ARGS FF (NIL . 2))
(PUSH P 1)
(PUSH P 2)
(CALL 2 'EQUAL)
(JUMPE 1 G0002)
(MOVE 1 -1 P)
(JSP T PDLNMK)
(CALL 1 'NCONS)
(JRST 0 G0001)
G0002
(MOVE 2 0 P)
(MOVE 1 -1 P)
(CALL 2 'REMAINDER)
(MOVE 7 0 1)
(JUMPN 7 G0006)
(MOVE 2 0 P)
(MOVE 1 -1 P)
(CALL 2 '*QUO)
(MOVE 2 0 P)
(CALL 2 'FF)
(MOVEI 2 0 1)
(MOVE 1 0 P)
(JSP T PDLNMK)
(CALL 2 'CONS)
(JRST 0 G0001)
G0006
(MOVE 2 0 P)
(MOVE 1 -1 P)
(CALL 2 '*QUO)
(MOVE 2 0 P)
(CALL 2 '*LESS)
(JUMPE 1 G0012)
(MOVE 1 -1 P)
(JSP T PDLNMK)
(CALL 1 'NCONS)
(JRST 0 G0001)
G0012
(MOVE 7 @ 0 P)
(CAIE 7 2)
(JRST 0 G0017)
(MOVEI 2 '3)
(MOVE 1 -1 P)
(CALL 2 'FF)
(JRST 0 G0001)
G0017
(MOVEI 2 '2)
(MOVE 1 0 P)
(CALL 2 '*PLUS)
(MOVEI 2 0 1)
(MOVE 1 -1 P)
(CALL 2 'FF)
G0001
(SUB P (% 0 0 2 2))
(POPJ P)
NIL
(LAP FL SUBR)
(ARGS FL (NIL . 1))
(MOVEI 2 '2)
(CALL 2 'FF)
(JCALL 1 'CLEAN)
NIL
(SETQ PRIMELIST '(2 3 5 7))
(LAP LIST-PRIMES SUBR)
(ARGS LIST-PRIMES (NIL . 1))
(PUSH P 1)
(MOVE 1 (SPECIAL PRIMELIST))
(CALL 1 'REVERSE)
(HLRZ 2 0 1)
(PUSH P 1)
(PUSH P 2)
(PUSH P (% 0 0 'NIL))
(PUSH P (% 0 0 'NIL))
G0001
(MOVE 2 -2 P)
(MOVEI 1 '2)
(CALL 2 '*PLUS)
(MOVEM 1 -2 P)
(MOVE 2 -4 P)
(CALL 2 '*GREAT)
(JUMPE 1 G0006)
(MOVE 1 -3 P)
(CALL 1 'REVERSE)
(MOVEM 1 (SPECIAL PRIMELIST))
(CALL 1 'LENGTH)
(JRST 0 G0011)
G0006
(MOVE 5 (SPECIAL PRIMELIST))
(MOVEM 5 0 P)
G0002
(HLRZ 1 @ 0 P)
(HRRZ 2 @ 0 P)
(MOVEM 1 -1 P)
(MOVEM 2 0 P)
(EXCH 2 1)
(MOVE 1 -2 P)
(CALL 2 '*QUO)
(MOVE 2 -1 P)
(CALL 2 '*LESS)
(JUMPE 1 G0015)
(MOVE 2 -3 P)
(MOVE 1 -2 P)
(CALL 2 'CONS)
(MOVEM 1 -3 P)
(JRST 0 G0001)
G0015
(MOVE 2 -1 P)
(MOVE 1 -2 P)
(CALL 2 'REMAINDER)
(MOVE 7 0 1)
(JUMPE 7 G0001)
(JRST 0 G0002)
G0011
(SUB P (% 0 0 5 5))
(POPJ P)
NIL
(LAP RUNP SUBR)
(ARGS RUNP (NIL . 1))
(PUSH P 1)
(JSP T PDLNMK)
(PUSH P 1)
(JSP T (NPUSH -3))
G0001
(MOVE 5 -3 P)
(MOVE 4 (SPECIAL F-LIST))
(MOVEM 4 -1 P)
(MOVEM 5 -2 P)
G0002
(HLRZ 1 @ -1 P)
(MOVEM 1 (SPECIAL CPL))
(HRRZ 2 @ -1 P)
(MOVEM 2 -1 P)
(HLRZ 2 0 1)
(MOVE 1 -2 P)
(CALL 2 '*TIMES)
(MOVEM 1 (SPECIAL M1))
(CALL 1 'ADD1)
(MOVEM 1 -3 P)
(MOVEI 3 0 1)
(MOVE 2 (SPECIAL M1))
(MOVEI 1 '3)
(CALL 3 'SEX)
(MOVEI 2 '1)
(CALL 2 'EQUAL)
(JUMPE 1 G0010)
(PUSH P (SPECIAL CPL))
(HRRZ 2 @ 0 P)
(MOVE 1 -3 P)
(CALL 2 'CONS)
(MOVEI 3 0 1)
(MOVE 2 (SPECIAL M1))
(MOVE 1 -4 P)
(CALL 3 'FTEST)
(MOVEM 1 -1 P)
(CALL 1 'NCONS)
(POP P 2)
(CALL 2 'XCONS)
(MOVE 2 -3 P)
(CALL 2 'XCONS)
(CALL 1 'PRINT)
(SKIPE 1 0 P)
(JRST 0 G0001)
(JRST 0 G0002)
G0010
(JRST 0 G0002)
NIL
(LAP RUNP2 SUBR)
(ARGS RUNP2 (NIL . 1))
(PUSH P 1)
(JSP T PDLNMK)
(PUSH P 1)
(PUSH P 1)
(PUSH P (% 0 0 'NIL))
(PUSH P (% 0 0 'NIL))
G0001
(MOVE 5 -3 P)
(MOVEM 5 (SPECIAL PPM))
(MOVE 4 -2 P)
(MOVE 3 (SPECIAL F-LIST))
(MOVEM 3 -1 P)
(MOVEM 4 -3 P)
G0002
(HLRZ 1 @ -1 P)
(MOVEM 1 (SPECIAL CPL))
(HRRZ 2 @ -1 P)
(MOVEM 2 -1 P)
(MOVEI T G0006)
(PUSH P T)
(PUSH P (SPECIAL PPM))
(PUSH P -5 P)
(HLRZ 1 0 1)
(PUSH P 1)
(MOVNI T 3)
(JCALL 16 'TIMES)
G0006
(MOVEM 1 (SPECIAL M1))
(CALL 1 'ADD1)
(MOVEM 1 -2 P)
(MOVEI 3 0 1)
(MOVE 2 (SPECIAL M1))
(MOVEI 1 '3)
(CALL 3 'SEX)
(MOVEI 2 '1)
(CALL 2 'EQUAL)
(JUMPE 1 G0011)
(PUSH P (SPECIAL CPL))
(HRRZ 2 @ 0 P)
(MOVE 1 -4 P)
(CALL 2 'CONS)
(MOVE 2 (SPECIAL PPM))
(CALL 2 'XCONS)
(MOVEI 3 0 1)
(MOVE 2 (SPECIAL M1))
(MOVE 1 -3 P)
(CALL 3 'FTEST)
(MOVEM 1 -1 P)
(CALL 1 'NCONS)
(POP P 2)
(CALL 2 'XCONS)
(MOVE 2 -2 P)
(CALL 2 'XCONS)
(CALL 1 'PRINT)
(SKIPE 1 0 P)
(JRST 0 G0001)
(JRST 0 G0002)
G0011
(JRST 0 G0002)
NIL
(LIST-PRIMES 50)
(SETQ KPL PRIMELIST)
(SETQ KPL PRIMELIST)
(LIST-PRIMES 310)
(LAP FTEST SUBR)
(ARGS FTEST (NIL . 3))
(JSP T SPECBIND)
(0 2 (SPECIAL M1))
(PUSH P 1)
(PUSH P 3)
G0001
(SKIPE 1 0 P)
(JRST 0 G0003)
(MOVEI 1 'T)
(JRST 0 G0004)
G0003
(HLRZ 3 0 1)
(MOVE 2 (SPECIAL M1))
(MOVE 1 -1 P)
(CALL 3 'FTEST4)
(JUMPE 1 G0005)
(HRRZ 2 @ 0 P)
(MOVEM 2 0 P)
(JRST 0 G0001)
G0005
(MOVEI 1 'NIL)
G0004
(SUB P (% 0 0 2 2))
(JRST 0 UNBIND)
NIL
(LAP MAKE-LIST SUBR)
(ARGS MAKE-LIST (NIL . 1))
(PUSH P 1)
(SETZM 0 (SPECIAL F-LIST))
G0001
(MOVE 2 0 P)
(MOVEI 1 '2)
(CALL 2 '*TIMES)
(MOVE 2 0 P)
(PUSH P 1)
(MOVEI 1 '2)
(CALL 2 '*TIMES)
(CALL 1 'FL)
(POP P 2)
(CALL 2 'XCONS)
(MOVE 2 (SPECIAL F-LIST))
(CALL 2 'CONS)
(MOVEM 1 (SPECIAL F-LIST))
(MOVEI 2 '1)
(MOVE 1 0 P)
(CALL 2 'EQUAL)
(JUMPE 1 G0007)
(MOVEI 1 'DONE)
(JRST 0 G0010)
G0007
(MOVE 1 0 P)
(CALL 1 'SUB1)
(MOVEM 1 0 P)
(JRST 0 G0001)
G0010
(SUB P (% 0 0 1 1))
(POPJ P)
NIL
(LAP FTEST4 SUBR)
(ARGS FTEST4 (NIL . 3))
(JSP T SPECBIND)
(0 2 (SPECIAL M1))
(PUSH P 1)
(PUSH P 3)
(PUSH P (SPECIAL KPL))
G0001
(SKIPN 1 0 P)
(JRST 0 G0003)
(MOVE 2 -1 P)
(HLRZ 1 0 1)
(CALL 2 'EQUAL)
(JUMPE 1 G0004)
(HRRZ 2 @ 0 P)
(MOVEM 2 0 P)
(JRST 0 G0001)
G0004
(MOVE 2 -1 P)
(MOVE 1 (SPECIAL M1))
(CALL 2 '*QUO)
(MOVE 3 -2 P)
(MOVEI 2 0 1)
(HLRZ 1 @ 0 P)
(CALL 3 'SEX)
(MOVEI 2 '1)
(CALL 2 'EQUAL)
(JUMPN 1 G0008)
(MOVE 3 -2 P)
(MOVE 2 (SPECIAL M1))
(HLRZ 1 @ 0 P)
(CALL 3 'SEX)
(MOVEI 2 '1)
(CALL 2 'EQUAL)
(JRST 0 G0016)
G0008
(HRRZ 2 @ 0 P)
(MOVEM 2 0 P)
(JRST 0 G0001)
G0003
(MOVEI 1 'NIL)
G0016
(SUB P (% 0 0 3 3))
(JRST 0 UNBIND)
NIL
(SETQ F-LIST NIL)
(MAKE-LIST 144)
(LAP TP SUBR)
(ARGS TP (NIL . 1))
(PUSH P 1)
(CALL 1 'SUB1)
(MOVE 3 0 P)
(MOVEI 2 0 1)
(MOVEI 1 '3)
(CALL 3 'SEX)
(MOVEI 2 '1)
(CALL 2 'EQUAL)
(JUMPE 1 G0002)
(MOVE 1 0 P)
(CALL 1 'SUB1)
(PUSH P 1)
(MOVE 1 -1 P)
(CALL 1 'SUB1)
(CALL 1 'FL)
(MOVEI 3 0 1)
(POP P 2)
(MOVE 1 0 P)
(CALL 3 'FTEST)
G0002
(SUB P (% 0 0 1 1))
(POPJ P)
NIL
(LAP PS SUBR)
(ARGS PS (NIL . 1))
(MOVEI 5 '2)
(PUSH P (SPECIAL PRIMELIST))
(PUSH P (% 0 0 '1))
(JSP T SPECBIND)
(0 5 (SPECIAL K))
(PUSH P 1)
G0002
(MOVE 2 0 P)
(MOVE 1 -1 P)
(CALL 2 'EQUAL)
(JUMPE 1 G0003)
(MOVE 1 (SPECIAL K))
(JRST 0 G0006)
G0003
(MOVE 1 -1 P)
(CALL 1 'ADD1)
(HRRZ 2 @ -2 P)
(HLRZ 2 0 2)
(PUSH P 1)
(MOVE 1 (SPECIAL K))
(CALL 2 '*TIMES)
(MOVEM 1 (SPECIAL K))
(HRRZ 2 @ -3 P)
(MOVEM 2 -3 P)
(POP P -2 P)
(JRST 0 G0002)
G0006
(SUB P (% 0 0 3 3))
(JRST 0 UNBIND)
NIL
(LAP TP1 SUBR)
(ARGS TP1 (NIL . 2))
(PUSH P 1)
(PUSH P 2)
(CALL 1 'SUB1)
(MOVE 3 -1 P)
(EXCH 2 1)
(MOVEI 1 '3)
(CALL 3 'SEX)
(MOVEI 2 '1)
(CALL 2 'EQUAL)
(JUMPE 1 G0002)
(MOVE 1 -1 P)
(CALL 1 'SUB1)
(PUSH P 1)
(MOVE 1 -2 P)
(CALL 1 'SUB1)
(MOVE 2 -1 P)
(CALL 2 'CUTDOWN)
(CALL 1 'FL)
(MOVEI 2 0 1)
(MOVE 1 -1 P)
(CALL 2 '*APPEND)
(MOVEI 3 0 1)
(POP P 2)
(MOVE 1 -1 P)
(CALL 3 'FTEST)
G0002
(SUB P (% 0 0 2 2))
(POPJ P)
NIL
(LAP CUTDOWN SUBR)
(ARGS CUTDOWN (NIL . 2))
(JSP T SPECBIND)
(0 1 (SPECIAL M1))
(PUSH P 2)
(JUMPE 2 G0001)
G0002
(HLRZ 2 0 2)
(CALL 2 '*QUO)
(HRRZ 2 @ 0 P)
(CALL 2 'CUTDOWN)
G0001
(SUB P (% 0 0 1 1))
(JRST 0 UNBIND)
NIL
βββ